home *** CD-ROM | disk | FTP | other *** search
/ Network PC / Network PC.iso / amigadiskfiles / assassins / asi044.adf / ROLL-ON / LoadILBM-SaveACBM (.txt) < prev    next >
Encoding:
AmigaBASIC Source Code  |  1990-03-01  |  14.5 KB  |  615 lines
  1. REM - LoadILBM-SaveACBM
  2. REM -  by Carolyn Scheppner  CBM  04/86
  3.  
  4. REM -  Modified for PAL/NTSC  07/87
  5. REM -  NOTE:  Only PAL ILBMs will be
  6. REM -    displayed in a PAL height
  7. REM -    screen.  PAL ILBM's contain
  8. REM -    a PAL screenheight in their
  9. REM -    BMHD pageHeight field
  10.  
  11. REM - This program loads an IFF ILBM
  12. REM -  (Graphicraft,Deluxe Paint, etc.)
  13. REM -  into a custom screen/window.
  14. REM -  If a Graphicraft color cycling
  15. REM -  chunk (CCRT) is found, it will
  16. REM -  also demo the color cycling.
  17.  
  18. REM - If the user wishes, the screen
  19. REM -  is then saved in a file format
  20. REM -  (ACBM - Amiga Contiguous BitMap)
  21. REM -  which an AmigaBasic program can
  22. REM -  load more quickly. (LoadACBM)
  23. REM -  The ACBM form is similar to
  24. REM -  an ILBM form, except an ABIT
  25. REM -  chunk replaces the interleaved 
  26. REM -  BODY chunk.  ABIT contains
  27. REM -  sequential contiguous Amiga
  28. REM -  BitPlane data.
  29.  
  30. REM - Requires exec, graphics and dos
  31. REM -  .bmaps (Use new ConvertFD)
  32. REM
  33.  
  34. Main:
  35.  
  36. PRINT "LoadILBM-SaveACBM --- ILBM loader and converter"
  37. PRINT
  38. PRINT " This program loads and displays an IFF ILBM pic file"
  39. PRINT "(Graphicraft, DPaint, Images) and optionally saves it"
  40. PRINT "in ACBM format (see comments for description)."
  41. PRINT "ACBM files can be loaded more quickly from Basic."
  42. PRINT
  43. PRINT " Uncompacted ILBMs (Graphicraft) load fairly quickly but"
  44. PRINT "compacted ILBMs (DPaint, Images) have long load times."
  45. PRINT "Screen blanking during the load has been commented out"
  46. PRINT "so the progress of the load can be monitored."
  47. PRINT 
  48.  
  49. DIM bPlane&(5), cTabWork%(32), cTabSave%(32)
  50.  
  51. REM - Must create cycling variables
  52. REM -  because this version of SaveACBM
  53. REM -  always saves a CCRT chunk
  54. ccrtDir%   = 0
  55. ccrtStart% = 0
  56. ccrtEnd%   = 0
  57. ccrtSecs&  = 0
  58. ccrtMics&  = 0
  59.  
  60.  
  61. REM - Functions from dos.library                   
  62. DECLARE FUNCTION xOpen&  LIBRARY
  63. DECLARE FUNCTION xRead&  LIBRARY
  64. DECLARE FUNCTION xWrite& LIBRARY
  65. REM - xClose returns no value
  66.  
  67. REM - Functions from exec.library
  68. DECLARE FUNCTION AllocMem&() LIBRARY
  69. REM - FreeMem returns no value
  70.  
  71. PRINT:PRINT "Looking for bmaps ... ";
  72. LIBRARY "dos.library"
  73. LIBRARY "exec.library"
  74. LIBRARY "graphics.library"
  75. PRINT "found them."
  76. PRINT:PRINT "ENTER FILESPECS:"
  77. PRINT "( Try any ILBM filespec )"
  78. PRINT "( Do not save ACBM if your disk has less than 41K free )"
  79. PRINT "( To view ILBM without saving ACBM, enter <RET> for ACBM filespec )"
  80. PRINT
  81.  
  82. GetNames:
  83. INPUT "   IFF ILBM filespec";ILBMname$
  84. IF (ILBMname$ = "") GOTO Mcleanup2
  85.  
  86. INPUT "   ACBM filespec";ACBMname$
  87. PRINT
  88.  
  89. REM - Load the IFF ILBM pic
  90. loadError$ = ""
  91. GOSUB LoadILBM
  92. IF loadError$ <> "" THEN GOTO Mcleanup
  93.  
  94. REM - Demo Graphicraft color cycling
  95. IF foundCCRT AND ccrtDir% THEN
  96.    REM - Save colors
  97.    FOR kk = 0 TO nColors% -1
  98.       cTabSave%(kk) = PEEKW(colorTab&+(kk*2))   
  99.       cTabWork%(kk) = cTabSave%(kk)
  100.    NEXT
  101.    
  102.    REM - Cycle colors
  103.    FOR kk = 0 TO 80
  104.       IF ccrtDir% = 1 THEN
  105.          GOSUB Fcycle
  106.       ELSE   
  107.          GOSUB Bcycle
  108.       END IF
  109.  
  110.       CALL LoadRGB4&(sViewPort&,VARPTR(cTabWork%(0)),nColors%)
  111.       REM - Delays approximated
  112.       FOR de1 = 0 TO ccrtSecs& * 3000
  113.          FOR de2 = 0 TO ccrtMics& / 500
  114.          NEXT
  115.       NEXT
  116.    NEXT
  117.  
  118.    REM - Restore colors
  119.    CALL LoadRGB4&(sViewPort&,VARPTR(cTabSave%(0)),nColors%)
  120. END IF
  121.  
  122.  
  123. REM - Save screen as ACBM file
  124. IF (loadError$ = "") AND (ACBMname$<>"") THEN
  125.    saveError$ = ""
  126.    GOSUB SaveACBM
  127. END IF
  128.  
  129. Mcleanup:
  130. FOR de = 1 TO 20000:NEXT
  131. WINDOW CLOSE 2
  132. SCREEN CLOSE 2
  133.  
  134. Mcleanup2:
  135. LIBRARY CLOSE
  136. IF loadError$ <> "" THEN PRINT loadError$
  137. IF saveError$ <> "" THEN PRINT saveError$
  138.  
  139. END
  140.  
  141.  
  142. Bcycle:  'Backward color cycle
  143. cTemp% = cTabWork%(ccrtEnd%)
  144. FOR jj = ccrtEnd%-1 TO ccrtStart% STEP -1
  145.    cTabWork%(jj+1) = cTabWork%(jj)
  146. NEXT
  147. cTabWork%(ccrtStart%) = cTemp%
  148. RETURN
  149.  
  150. Fcycle:  'Forward color cycle
  151. cTemp% = cTabWork%(ccrtStart%)
  152. FOR jj = ccrtStart%+1 TO ccrtEnd%
  153.    cTabWork%(jj-1) = cTabWork%(jj)
  154. NEXT
  155. cTabWork%(ccrtEnd%) = cTemp%
  156. RETURN
  157.  
  158.  
  159. LoadILBM:
  160. REM - Requires the following variables
  161. REM - to have been initialized:
  162. REM -    ILBMname$ (IFF filename)
  163.  
  164. REM - init variables
  165. f$ = ILBMname$
  166. fHandle& = 0
  167. mybuf& = 0
  168. foundBMHD = 0
  169. foundCMAP = 0
  170. foundCamg = 0
  171. foundCCRT = 0
  172. foundBODY = 0
  173.  
  174. REM - From include/libraries/dos.h
  175. REM - MODE_NEWFILE = 1006 
  176. REM - MODE_OLDFILE = 1005
  177.  
  178. filename$ = f$ + CHR$(0)
  179. fHandle& = xOpen&(SADD(filename$),1005)
  180. IF fHandle& = 0 THEN
  181.    loadError$ = "Can't open/find pic file"
  182.    GOTO Lcleanup
  183. END IF
  184.  
  185.  
  186. REM - Alloc ram for work buffers
  187. ClearPublic& = 65537
  188. mybufsize& = 360
  189. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  190. IF mybuf& = 0 THEN
  191.    loadError$ = "Can't alloc buffer"
  192.    GOTO Lcleanup
  193. END IF
  194.  
  195. inbuf& = mybuf&
  196. cbuf& = mybuf& + 120
  197. ctab& = mybuf& + 240
  198.  
  199.  
  200. REM - Should read  FORMnnnnILBM
  201. rLen& = xRead&(fHandle&,inbuf&,12)
  202. tt$ = ""
  203. FOR kk = 8 TO 11
  204.    tt% = PEEK(inbuf& + kk)
  205.    tt$ = tt$ + CHR$(tt%)
  206. NEXT
  207.  
  208. IF tt$ <> "ILBM" THEN 
  209.    loadError$ = "Not standard ILBM pic file"
  210.    GOTO Lcleanup
  211. END IF
  212.  
  213. REM - Read ILBM chunks
  214.  
  215. ChunkLoop:
  216. REM - Get Chunk name/length
  217.  rLen& = xRead&(fHandle&,inbuf&,8)
  218.  icLen& = PEEKL(inbuf& + 4)
  219.  tt$ = ""
  220.  FOR kk = 0 TO 3
  221.     tt% = PEEK(inbuf& + kk)
  222.     tt$ = tt$ + CHR$(tt%)
  223.  NEXT   
  224.     
  225. IF tt$ = "BMHD" THEN  'BitMap header 
  226.    foundBMHD = 1
  227.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  228.    iWidth%  = PEEKW(inbuf&)
  229.    iHeight% = PEEKW(inbuf& + 2)
  230.    iDepth%  = PEEK(inbuf& + 8)  
  231.    iCompr%  = PEEK(inbuf& + 10)
  232.    scrWidth%  = PEEKW(inbuf& + 16)
  233.    scrHeight% = PEEKW(inbuf& + 18)
  234.  
  235.    iRowBytes% = iWidth% /8
  236.    scrRowBytes% = scrWidth% / 8
  237.    nColors%  = 2^(iDepth%)
  238.  
  239.    REM - Enough free ram to display ?
  240.    AvailRam& = FRE(-1)
  241.    NeededRam& = ((scrWidth%/8)*scrHeight%*(iDepth%+1))+5000
  242.    IF AvailRam& < NeededRam& THEN
  243.       loadError$ = "Not enough free ram"
  244.       GOTO Lcleanup
  245.    END IF
  246.  
  247.    hires& = &H8000
  248.    lace&  = &H4
  249.    kk = 1
  250.    IF foundCamg THEN
  251.       IF (camgModes& AND hires&) THEN kk = kk+1
  252.       IF (camgModes& AND lace&)  THEN kk = kk+2
  253.    ELSE   
  254.       IF scrWidth% >= 640 THEN kk = kk + 1
  255.       IF scrHeight% >= 400 THEN kk = kk + 2
  256.    END IF
  257.    
  258.    SCREEN 2,scrWidth%,scrHeight%,iDepth%,kk
  259.    WINDOW 2,"LoadILBM-SaveACBM",,7,2
  260.  
  261.    REM - Get addresses of structures
  262.    GOSUB GetScrAddrs
  263.  
  264.    REM - Black out screen
  265.    REM CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  266.  
  267.  
  268. ELSEIF tt$ = "CMAP" THEN  'ColorMap
  269.    foundCMAP = 1
  270.    rLen& = xRead&(fHandle&,cbuf&,icLen&)
  271.  
  272.    REM - Build Color Table
  273.    FOR kk = 0 TO nColors% - 1
  274.       red% = PEEK(cbuf&+(kk*3))
  275.       gre% = PEEK(cbuf&+(kk*3)+1)
  276.       blu% = PEEK(cbuf&+(kk*3)+2)
  277.       regTemp% = (red%*16)+(gre%)+(blu%/16)
  278.       POKEW(ctab&+(2*kk)),regTemp%
  279.    NEXT
  280.  
  281.  
  282. ELSEIF tt$ = "CAMG" THEN  'Amiga ViewPort Modes
  283.    foundCamg = 1
  284.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  285.    camgModes& = PEEKL(inbuf&)
  286.  
  287.  
  288. ELSEIF tt$ = "CCRT" THEN 'Graphicraft color cycle info
  289.    foundCCRT = 1
  290.    rLen& = xRead&(fHandle&,inbuf&,icLen&)
  291.    ccrtDir%    = PEEKW(inbuf&)
  292.    ccrtStart%  = PEEK(inbuf& + 2)
  293.    ccrtEnd%    = PEEK(inbuf& + 3)
  294.    ccrtSecs&   = PEEKL(inbuf& + 4)
  295.    ccrtMics&   = PEEKL(inbuf& + 8)
  296.  
  297.  
  298. ELSEIF tt$ = "BODY" THEN  'BitMap 
  299.    foundBODY = 1
  300.   
  301.    IF iCompr% = 0 THEN  'no compression
  302.       FOR rr = 0 TO iHeight% -1
  303.          FOR pp = 0 TO iDepth% -1
  304.             scrRow& = bPlane&(pp)+(rr*scrRowBytes%)
  305.             rLen& = xRead&(fHandle&,scrRow&,iRowBytes%)   
  306.          NEXT
  307.       NEXT
  308.  
  309.  
  310.    ELSEIF iCompr% = 1 THEN  'cmpByteRun1
  311.       FOR rr = 0 TO iHeight% -1
  312.          FOR pp = 0 TO iDepth% -1
  313.             scrRow& = bPlane&(pp)+(rr*scrRowBytes%)
  314.             bCnt% = 0
  315.             
  316.             WHILE (bCnt% < iRowBytes%)
  317.                rLen& = xRead&(fHandle&,inbuf&,1)
  318.                inCode% = PEEK(inbuf&)
  319.                IF inCode% < 128 THEN
  320.                   rLen& = xRead&(fHandle&,scrRow& + bCnt%, inCode%+1)
  321.                   bCnt% = bCnt% + inCode% + 1
  322.                ELSEIF inCode% > 128 THEN
  323.                   rLen& = xRead&(fHandle&,inbuf&,1)   
  324.                   inByte% = PEEK(inbuf&)
  325.                   FOR kk = bCnt% TO bCnt% + 257 - inCode%
  326.                      POKE(scrRow&+kk),inByte%
  327.                   NEXT   
  328.                   bCnt% = bCnt% + 257 - inCode%
  329.                END IF
  330.             WEND
  331.          NEXT
  332.       NEXT
  333.          
  334.    ELSE
  335.       loadError$ = "Unknown compression algorithm"
  336.       GOTO Lcleanup
  337.    END IF
  338.  
  339.  
  340. ELSE 
  341.    REM - Reading unknown chunk  
  342.    FOR kk = 1 TO icLen&
  343.       rLen& = xRead&(fHandle&,inbuf&,1)
  344.    NEXT
  345.    REM - If odd length, read 1 more byte
  346.    IF (icLen& OR 1) = icLen& THEN 
  347.       rLen& = xRead&(fHandle&,inbuf&,1)
  348.    END IF
  349.       
  350. END IF
  351.  
  352.  
  353. REM - Done if got all chunks 
  354. IF foundBMHD AND foundCMAP AND foundBODY THEN
  355.    GOTO GoodLoad
  356. END IF
  357.  
  358. REM - Good read, get next chunk
  359. IF rLen& > 0 THEN GOTO ChunkLoop
  360.  
  361. IF rLen& < 0 THEN  'Read error
  362.    loadError$ = "Read error"
  363.    GOTO Lcleanup
  364. END IF   
  365.  
  366. REM - rLen& = 0 means EOF
  367. IF (foundBMHD=0) OR (foundBODY=0) OR (foundCMAP=0) THEN
  368.    loadError$ = "Needed ILBM chunks not found"
  369.    GOTO Lcleanup
  370. END IF
  371.  
  372.  
  373. GoodLoad:
  374. loadError$ = ""
  375.  
  376. REM  Load proper Colors
  377. IF foundCMAP THEN 
  378.    CALL LoadRGB4&(sViewPort&,ctab&,nColors%)
  379. END IF
  380.  
  381. Lcleanup:
  382. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  383. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  384.  
  385. RETURN
  386.  
  387.  
  388.  
  389. SaveACBM:
  390. REM - Saves current window's screen
  391. REM - Requires the following variables
  392. REM - to have been initialized:
  393. REM -    ACBMname$ (ACBM filespec)
  394. REM - Also, if cycling info is to be stored
  395. REM -    ccrtDir% (1,-1, or 0 = none)
  396. REM -    ccrtStart% (low cycle reg)
  397. REM -    ccrtEnd%   (high cycle reg)
  398. REM -    ccrtSecs&  (cycle time in seconds)
  399. REM -    ccrtMics&  (cycle time in microseconds)
  400. REM 
  401. REM
  402. REM - Format of ACBM file:
  403. REM -    LONG   "FORM"
  404. REM -    LONG   size of rest of file
  405. REM -    LONG   "ACBM" (form type)
  406. REM 
  407. REM -    LONG   "BMHD" (std IFF BitMap header chunk)
  408. REM -    LONG   size of BMHD chunk = 20
  409. REM -    UWORD  w (bitmap width in pixels)
  410. REM -    UWORD  h (bitmap height)
  411. REM -    WORD   x (nw corner) = 0
  412. REM -    WORD   y (nw corner) = 0
  413. REM -    UBYTE  nPlanes
  414. REM -    UBYTE  masking = 0
  415. REM -    UBYTE  compression = 0
  416. REM -    UBYTE  pad1 = 0
  417. REM -    UWORD  transparentColor = 0
  418. REM -    UBYTE  xAspect (pixel) = 10
  419. REM -    UBYTE  yAspect (pixel) = 11
  420. REM -    WORD   pageWidth (screen width in pixels)    
  421. REM -    WORD   pageHeight (screen height in pixels)
  422. REM 
  423. REM -    LONG   "CMAP" (std IFF ColorMap chunk)
  424. REM -    LONG   size of CMAP chunk
  425. REM -    UBYTE  Sets of 3 UBYTES (red, green, blue)
  426. REM -           (2^nPlanes sets)
  427. REM -           (rgb values LEFT justified in each UBYTE)
  428. REM
  429. REM -    LONG   "CAMG" (Amiga ViewPort Modes)
  430. REM -    LONG   size of CAMG chunk
  431. REM -    LONG   Mode
  432. REM
  433. REM -    LONG   "CCRT"  (Graphicraft color cycle info)
  434. REM -    WORD   direction (1,-1, or 0 = none)
  435. REM -    UBYTE  start  (low cycle reg)
  436. REM -    UBYTE  end    (high cycle reg)
  437. REM -    LONG   seconds (cycle time)
  438. REM -    LONG   microseconds (cycle time)
  439. REM -    WORD   pad = 0
  440. REM
  441. REM      (Amiga bitplanes 0, 1, etc)
  442. REM -    LONG   "ABIT"
  443. REM -    LONG   size of ABIT chunk
  444. REM -           BitPlanes 0 thru nPlanes - 1
  445. REM -          (each is h * (w/8) bytes)
  446.  
  447.  
  448. REM - init variables
  449. f$ = ACBMname$
  450. fHandle& = 0
  451. mybuf& = 0
  452.  
  453. filename$ = f$ + CHR$(0)
  454. fHandle& = xOpen&(SADD(filename$),1006)
  455. IF fHandle& = 0 THEN
  456.    saveError$ = "Can't open output file"
  457.    GOTO Scleanup
  458. END IF
  459.  
  460. REM - Alloc ram for work buffers
  461. ClearPublic& = 65537
  462. mybufsize& = 120
  463. mybuf& = AllocMem&(mybufsize&,ClearPublic&)
  464. IF mybuf& = 0 THEN
  465.    saveError$ = "Can't alloc buffer"
  466.    GOTO Scleanup
  467. END IF
  468.  
  469. cbuf& = mybuf&
  470.  
  471. REM - Get addresses of screen structures
  472. GOSUB GetScrAddrs
  473.  
  474. zero& = 0
  475. pad%  = 0
  476. aspect% = &Ha0b
  477.  
  478. REM - Compute chunk sizes
  479. BMHDsize& = 20
  480. CMAPsize& = (2^scrDepth%) * 3
  481. CAMGsize& = 4
  482. CCRTsize& = 14
  483. ABITsize& = (scrWidth%/8) * scrHeight% * scrDepth%
  484. REM - FORMsize& = Chunk sizes + 8 bytes per Chunk header + "ACBM"
  485. FORMsize& = BMHDsize&+CMAPsize&+CAMGsize&+CCRTsize&+ABITsize&+44
  486.  
  487. REM - Write FORM header
  488. tt$ = "FORM"
  489. wLen& = xWrite&(fHandle&,SADD(tt$),4)
  490. wLen& = xWrite&(fHandle&,VARPTR(FORMsize&),4)
  491. tt$ = "ACBM"
  492. wLen& = xWrite&(fHandle&,SADD(tt$),4)
  493.  
  494. IF wLen& <= 0 THEN
  495.    saveError$ = "Error writing FORM header"
  496.    GOTO Scleanup
  497. END IF   
  498.  
  499. REM - Write out BMHD chunk
  500. tt$ = "BMHD"
  501. wLen& = xWrite&(fHandle&,SADD(tt$),4)
  502. wLen& = xWrite&(fHandle&,VARPTR(BMHDsize&),4)
  503. wLen& = xWrite&(fHandle&,VARPTR(scrWidth%),2)
  504. wLen& = xWrite&(fHandle&,VARPTR(scrHeight%),2)
  505. wLen& = xWrite&(fHandle&,VARPTR(zero&),4)
  506. temp% = (256 * scrDepth%)
  507. wLen& = xWrite&(fHandle&,VARPTR(temp%),2)
  508. wLen& = xWrite&(fHandle&,VARPTR(zero&),4)
  509. wLen& = xWrite&(fHandle&,VARPTR(aspect%),2)
  510. wLen& = xWrite&(fHandle&,VARPTR(scrWidth%),2)
  511. wLen& = xWrite&(fHandle&,VARPTR(scrHeight%),2)
  512.  
  513. IF wLen& <= 0 THEN
  514.    saveError$ = "Error writing BMHD"
  515.    GOTO Scleanup
  516. END IF   
  517.  
  518. REM - Write CMAP chunk
  519. tt$ = "CMAP"
  520. wLen& = xWrite&(fHandle&,SADD(tt$),4)
  521. wLen& = xWrite&(fHandle&,VARPTR(CMAPsize&),4)
  522.  
  523. REM - Build IFF ColorMap
  524. FOR kk = 0 TO nColors% - 1
  525.    regTemp% = PEEKW(colorTab& + (2*kk))
  526.    POKE(cbuf&+(kk*3)),(regTemp% AND &Hf00) / 16
  527.    POKE(cbuf&+(kk*3)+1),(regTemp% AND &Hf0) 
  528.    POKE(cbuf&+(kk*3)+2),(regTemp% AND &Hf) * 16
  529. NEXT
  530.  
  531. wLen& = xWrite&(fHandle&,cbuf&,CMAPsize&)
  532.  
  533. IF wLen& <= 0 THEN
  534.    saveError$ = "Error writing CMAP"
  535.    GOTO Scleanup
  536. END IF   
  537.  
  538. REM - Write CAMG chunk
  539. tt$ = "CAMG"
  540. wLen& = xWrite&(fHandle&,SADD(tt$),4)
  541. wLen& = xWrite&(fHandle&,VARPTR(CAMGsize&),4)
  542. vpModes& = PEEKW(sViewPort& + 32)
  543. wLen& = xWrite&(fHandle&,VARPTR(vpModes&),4)
  544.  
  545. IF wLen& <= 0 THEN
  546.    saveError$ = "Error writing CAMG"
  547.    GOTO Scleanup
  548. END IF   
  549.  
  550. REM - Write CCRT chunk
  551. tt$ = "CCRT"
  552. wLen& = xWrite&(fHandle&,SADD(tt$),4)
  553. wLen& = xWrite&(fHandle&,VARPTR(CCRTsize&),4)
  554. wLen& = xWrite&(fHandle&,VARPTR(ccrtDir%),2)
  555. temp% = (256*ccrtStart%) + ccrtEnd%
  556. wLen& = xWrite&(fHandle&,VARPTR(temp%),2)
  557. wLen& = xWrite&(fHandle&,VARPTR(ccrtSecs&),4)
  558. wLen& = xWrite&(fHandle&,VARPTR(ccrtMics&),4)
  559. wLen& = xWrite&(fHandle&,VARPTR(pad%),2)
  560.  
  561. IF wLen& <= 0 THEN
  562.    saveError$ = "Error writing CCRT"
  563.    GOTO Scleanup
  564. END IF   
  565.  
  566.  
  567.  
  568. REM - Write ABIT chunk, bitplanes
  569. tt$ = "ABIT"
  570. wLen& = xWrite&(fHandle&,SADD(tt$),4)
  571. wLen& = xWrite&(fHandle&,VARPTR(ABITsize&),4)
  572.  
  573. bpLen& = (scrWidth% / 8) * scrHeight%
  574. FOR pp = 0 TO scrDepth% -1
  575.    wLen& = xWrite&(fHandle&,bPlane&(pp),bpLen&)
  576.    IF wLen& <= 0 THEN
  577.       saveError$ = "Error writing bit plane"+STR$(pp)
  578.       GOTO Scleanup
  579.    END IF   
  580. NEXT   
  581.  
  582. GoodSave:   
  583. saveError$ = ""
  584.  
  585. Scleanup:
  586. IF fHandle& <> 0 THEN CALL xClose&(fHandle&)
  587. IF mybuf& <> 0 THEN CALL FreeMem&(mybuf&,mybufsize&)
  588. RETURN
  589.  
  590.  
  591. GetScrAddrs:
  592. REM - Get addresses of screen structures
  593.    sWindow&   = WINDOW(7)
  594.    sScreen&   = PEEKL(sWindow& + 46)
  595.    sViewPort& = sScreen& + 44
  596.    sRastPort& = sScreen& + 84
  597.    sColorMap& = PEEKL(sViewPort& + 4)
  598.    colorTab&  = PEEKL(sColorMap& + 4)
  599.    sBitMap&   = PEEKL(sRastPort& + 4)
  600.  
  601.    REM - Get screen parameters
  602.    scrWidth%  = PEEKW(sScreen& + 12)
  603.    scrHeight% = PEEKW(sScreen& + 14)
  604.    scrDepth%  = PEEK(sBitMap& + 5)
  605.    nColors%   = 2^scrDepth%
  606.  
  607.    REM - Get addresses of Bit Planes 
  608.    FOR kk = 0 TO scrDepth% - 1
  609.       bPlane&(kk) = PEEKL(sBitMap&+8+(kk*4))
  610.    NEXT
  611. RETURN
  612.  
  613.  
  614.  
  615.